C  THIS PROGRAM CREATES FUNCTIONS FOR THE MUSIC PROGRAM USING 
C  'SEG' OR 'SYNTH'.  UP TO 10 FUNCTIONS CAN BE STORED IN A
C  SINGLE FILE.  ONCE CREATED, THE FUNCTIONS MAY BE CHANGED
C  AND PUT BACK IN THE SAME FILE OR INTO A NEW ONE.
C  NO MORE THAN 50 INPUTS FOR ONE FUNCTION!
C  TYPE 'C' (= CRUNCH)  FOR SPECIAL FEATURE SUBR.
C  'Z' FOR "CHANGE OR FINISH?" WILL JUMP DIRECTLY TO "CRUNCH" MODE.
C  WITH S(EE), <CR> WILL REPEAT SEE COMMAND WITHOUT ASKING FOR FILE.
C  'SP' (FOR "SEE") WILL PLOT ONE AT A TIME.
C  'SA' PLOTS ALL IN .DAT FILE ON CALCOMP
C  'SX' PLOTS ALL IN XGP FORMAT. (1ST→ <CTRL C>, A DSK PTP  --
C -- WHEN DONE→ <CTRL C>, F )  THEN USE "X" PROG. TYPE 6,11,1.
C FOR EXPONENTIALS GET INTO 'SEG'.  TYPE 'X', DECAY FAC, N.  IF 
C  N IS NON-ZERO THE FUNCTION WILL NOT! NORMALIZE (IE. NOT GO TO 0).
C  AFTER A FILE HAS BEEN READ IN, 
C  <CR> FOR 'TYPE FILE' WILL HOLD ON TO IT.
C  LOAD WITH -- WRIFUN,FUSUB,DFUNC,CURSOR,SSS,%LTVRLIB[1,TVR]
	COMMON/LN/LINE
	COMMON/S/H,AMP,CON,PH
	COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
	1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
	COMMON FUNC(512),F2(512),K,I
	DIMENSION RF(4)
21	FORMAT(' C=CHANGE, F=FINISH  '$)
22	FORMAT(' NEW FUNC, EDIT, CRUNCH, DELETE, RENAME, SEE?   '$)
23	FORMAT(' SEG OR SYNTH?   '$)
24	FORMAT(' TYPE FUNCTION NAME   '$)
25	FORMAT(' TYPE FILE NAME   '$)
26	FORMAT(I3,') TYPE AMPL, STEP# -- OR L=LTPEN   '$)
C  'X' HERE WILL MAKE EXPON. FUNC.
28	FORMAT(' 0=NORM,OR H,A,P,K   '$)
280	FORMAT(' NEW VERSION!  --REPORT ANY PROBLEMS TO LCS'/
	1' UP TO 10 FUNCTIONS MAY BE STORED IN EACH FILE'/
	1' TYPE "B" TO BACKUP AT ANY TIME'//)
30	FORMAT(8F)
31	FORMAT(1XA5,A1,5A5/)
34	FORMAT(A5,'(',A5,');',A5)
35	FORMAT(1XA5,'IN FILE "',A5,'.DAT"'/)
37	FORMAT(8F9.3)
371	FORMAT(I3,') ',4F8.2)
372	FORMAT(I,21F)
38	FORMAT(2(A5,A1),23A2)
40	FORMAT(11(A1,A3))
41	FORMAT(' ADD TO AN EXISTING FILE?   '$)
42	FORMAT(' WHICH FUNC?   '$)
47	FORMAT(' C=CHNG, I=INSRT, D=DEL -- + LN# & CHNGS '$)
48	FORMAT(' X,N(=DECAY FAC.) FOR XPONTLS')
2281	TYPE 280
281	KZ=0
C   USED IN RELATIVE VECTOR ROUTINE
	Z=0
	XZ=0
	EY=0
	ICUR=0
	XP=0
	KT=0
	FNUM=0
	OLD=0
	FNUM1=0
	TYPE 22
	ACCEPT 40,ON,P
	PLTALL=0
	IF(P.EQ.'A'.OR.P.EQ.'X')PLTALL=-1
1281	IPLOT=0
	XDPY=-1
	IF(ON.EQ.'N'.OR.(ON.EQ.' '.AND.ONX.NE.'S'))GO TO 1000
	IF(ON.NE.' ')GO TO 100
	ON=ONX
	XDPY=0
C  <CR> FOR 'SEE' WILL DISPLAY UP TO 3 FUNCS AT ONCE.
C  RETURNS FOR MORE "SEE"
	GO TO 4281
100	ONX=ON
	TYPE 25
	OLD=-1
	ACCEPT 38,FLNM1
	IF(FLNM1.EQ.' ')FLNM1=FLNM
	IF(FLNM1.EQ.0.OR.LOOKD(FLNM1).EQ.0)GO TO 100
	IF(FLNM.NE.FLNM1)GO TO 2151
	OLD=0
4281	TYPE 40,B
	IF(PLTALL)GO TO 5402
	GO TO 1402
2151	FLNM=FLNM1
	CALL READ1
3402	JX=-1
	LX=0
	IF(PLTALL)GO TO 402
C  "SA" WILL PLOT ALL FUNCS IN FILE
	TYPE 40,B
	IF(B(1,2).NE.' ')GO TO 1402
	FNUM1=B(2,1)
C  ONLY ONE FUNC IN FILE.
	GO TO 402
1402	TYPE 42
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 281
	REREAD 38,FNUM1
	IDEL=0
C  LX IS MAIN COUNTER
	IF(OLD)GO TO 402
	DO 1302 JX=1,10
1302	IF(FNUM1.EQ.FN(JX))GO TO 5402
	GO TO 3402
402	CALL READER
C  AT THIS POINT LX=TOTAL FUNCS+1
5402	IF(PLTALL)JX=1
1202	IF(ON.NE.'C'.AND.ON.NE.'S'.AND.ON.NE.'D')GO TO 3281
	IF(XDPY)CALL DPYX(1)
	CALL DPYF(JX,FUNC)
	IF(PLTALL.OR.P.EQ.'P'.OR.P.EQ.0)GO TO 2202
	IF(ON.EQ.'S')GO TO 2281
	IF(ON.EQ.'C')GO TO 1201
	TYPE 1139
	ACCEPT 40,IDEL
	IF(IDEL.EQ.'N')GO TO 2281
	IDEL=JX
	LX=LX-1
C  NOW LX=TOTAL # OF FUNCS.
	CALL WRIFUN
1139	FORMAT(' DELETE IT? ',$)
2202	CALL PLOTIT(FUNC,XA(JX),P)
	IF(P.EQ.'P')GO TO 2281
	JX=JX+1
	IF(B(2,JX).NE.' '.AND.JX.LE.10)GO TO 1202
C  "SA" KEEPS PLOTTING UNTIL NO MORE ARE FOUND
	GO TO 2281
3281	X=' '
	TYPE 31,XA(JX),X,FN(JX)
	JT=4
	IF(XA(JX).EQ.'SEG')JT=2
	KZ=1
	DO 137	K=1,50
	KZ=KZ+1
	DO 138 L=1,JT
138	A(K,L)=AA(L,K,JX)
137	IF(A(K,1).EQ.999.OR.A(K,2).GE.100)GO TO 4401

4401	Z=-1
	IF(A(K,2).LE.100)GO TO 4403
	IF(K.GT.1)GO TO 4404
	CALL DPYX(1)
	CALL DPYF(JX,FUNC)
	IF(ON.EQ.'R')GO TO 3032
	TYPE 4405
	A(1,2)=520
	GO TO 4201
4404	TYPE 4402
4403	IF(JT.EQ.2)EY='EG'
	GO TO 1032
4402	FORMAT('  IT WAS SMOOTHED.')
4405	FORMAT(' CANNOT EDIT CRUNCHED FUNCS.'/)
1000	TYPE 23
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 281
	REREAD 40,X,EY
1032	CALL ZERO(FUNC)
C  CLEARS THE FUNC.
	ISMOO=0
	IF(EY.EQ.'EG')GO TO 800
151	EY=0
	JT=4
C  FOR WRIFUN
1031	CALL DPYX(1)
15	KT=1
104	IF(Z.EQ.-1.OR.KT.LT.KZ)GO TO 102
	IF(Z.EQ.1)GO TO 2032
1041	KZ=0
	TYPE 28
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 509
	REREAD 30,(A(KT,K),K=1,4)
C ACCEPT HARM,AMPL,PHASE,KONSTANT(IF K>100, MULTIPLIES WAVE *(K-100))
102	H=A(KT,1)
	IF(H.EQ.0.OR.H.EQ.999.)GO TO 2200
C   999 ENDS 'READIN' SYNTHS
	IF(Z.GT.0)TYPE 371,KT,(A(KT,K),K=1,4)
	AMP=A(KT,2)
	PH=A(KT,3)
	CON=A(KT,4)
	CALL SYN(FUNC)
	KT=KT+1
	IF(KZ.LE.KT)CALL DPY(FUNC,1)
	GO TO 104
2201	IF(JT.NE.2.OR.A(KT-1,2).GT.100)GO TO 1201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(LX.GT.10)GO TO 204
	CALL STORE(10)
C  PUTS FROM A ARRAY TO AA ARRAY
	XA(K)='SEG'
	CALL DPYX(1)
	CALL DPYF(K,FUNC)
1201	CALL ZFUNC
C  THIS WILL BE FOR SPECIAL FEATURE PACKAGE
	IF(KT.EQ.512)GO TO 2281
C  FOR BACKUP
4201	EY='EG'
	KT=2
	GO TO 900
2200	CALL NORM(FUNC)
C   NORMALIZES THE FUNCTION
	CALL DPY(FUNC,1)
201	IF(BU.EQ.'C')GO TO 2032
	IF(ON.EQ.'R')GO TO 3032
204	TYPE 21
	IF(EY.EQ.'EG')TYPE 271
C   CHANGE IT?
	ACCEPT 40,BU
	IF(BU.EQ.'C')GO TO 210
	IF(BU.EQ.'F')GO TO 900
	IF(BU.EQ.'S')GO TO 7000
	IF(BU.EQ.'Z')GO TO 2201
C  TO USE CURRENT FUNC IN CRUNCH
	IF(BU.NE.'B')GO TO 2032
	IF(EY.EQ.'EG')GO TO 509
	GO TO 5091
C   NEXT IS FOR CHANGES ('C' OR <CR>)
2032	TYPE 47
	ACCEPT 40,K
	REREAD 372,L,X,RF
	IF(X.NE.0.OR.RF(1).NE.0)GO TO 211
	IF(EY.EQ.'EG')GO TO 204
	BU=0
	GO TO 1041
211	L=X
	IF(K.EQ.'I')GO TO 212
	IF(K.NE.'D')GO TO 205
C   JUMP IF NO DELETE
	KT=KT-1
	DO 209 K=L,KT
	DO 209 J=1,4
209	A(K,J)=A(K+1,J)
	GO TO 210
205	X=RF(2)
	IF(EY.NE.'EG')GO TO 1207
	IF(X.GE.A(L+1,2).AND.L.LT.KT-1)GO TO 2032
	GO TO 208
212	IF(RF(2).NE.0)GO TO 213
	RF(2)=RF(1)
	RF(1)=X
	L=KT
213	IF(EY.NE.'EG')GO TO 214
	X=RF(2)
	DO 215 K=1,KT
	Y=A(K,2)
	IF(X.GT.Y)GO TO 215
C   JUMP IF NOT PAST STEP NUM.
	L=K
	IF(X.EQ.Y)GO TO 208
C   IF STEP=ANOTHER STEP, IT WORKS LIKE 'C'HANGE.
	GO TO 214
215	CONTINUE
214	KT=KT+1
	DO 206 K=KT,L,-1
	DO 206 J=1,4
206	A(K,J)=A(K-1,J)
	GO TO 207
C   TO TYPE OLD NUMBERS
208	IF(X.LE.A(L-1,2).AND.L.GT.1)GO TO 2032
1207	TYPE 371,L,(A(L,K),K=1,4)
207	DO 202 K=1,4
202	A(L,K)=RF(K)
210	KZ=KT
	Z=1
	GO TO 1032
271	FORMAT('+S=SMOOTH  '$)
C  FOR RENAMES
3032	Z=-1
	GO TO 901
900	TYPE 41
C  ADD TO EXISTING FILE
	ISKP=0
	ACCEPT 40,Z
9000	IF(Z.EQ.'B')GO TO 204
	IF(Z.NE.'Y'.AND.Z.NE.'N')GO TO 900
	TYPE 25
	ACCEPT 38,FLNM
	IF(FLNM.EQ.' '.AND.FLNM1.NE.' ')FLNM=FLNM1
	IF(FLNM.EQ.'B'.OR.FLNM.EQ.' ')GO TO 204
CC	IF(LOOKD(FLNM).AND.Z.EQ.'N')GO TO 902
	IF(LOOKD(FLNM))GO TO 902
	IF(Z.NE.'N')GO TO 900
C  LOOKD CHECKS ON LOOK-UP
901	JT=4
	IF(EY.EQ.'EG')JT=2
	CALL WRIFUN
	GO TO 900
C  COMES BACK IF NO ROOM IN FILE FOR NEW FUNC.
902	IF(Z.NE.'N')GO TO 901
	TYPE 381,FLNM
	ACCEPT 40,Z
	IF(Z.NE.'N')GO TO 901
	GO TO 9000
381	FORMAT(' WRITE OVER ',A5,'.DAT?  ',$)

161	DO 261 K=1,512
261	FUNC(K)=EXP((1-K)/STEP)
	KT=2
	XP=-1
	IF(H.NE.0)GO TO 7009
C  H≠0 = NO NORMALIZATION OF XPONTL
	X=FUNC(512)
	DO 361 K=1,512
361	FUNC(K)=FUNC(K)-(K-1)/511.*X
	GO TO 7009
800	IF(XP)GO TO 510
	X=0
	JT=2
C  JT AND EY SEEM TO PERFORM THE SAME FUNCTIONS??
	Y=0
	KT=1
	N=-256
	CALL DPYX(2)
	CALL DPYBRT(5)
504	IF(KT.GE.KZ)GO TO 510
	AMP=A(KT,1)
5008	STEP=A(KT,2)
	IF(STEP.LE.A(KT-1,2).AND.KT.GT.1)GO TO 509
C   SO IT CAN'T GO BACKWARDS
	GO TO 5071
434	ICUR=0
	CALL CLRCUR
	GO TO 510
C   EXIT FROM CURSOR
CC431	CALL SETCUR(-256,128,0)
431	NX=-256
	NY=128
	NZ=0
C  TYPE <CR> HERE TO SET FIRST POINT AT 0,0
	ICUR=-1
433	CALL SETCUR(NX,NY,NZ)
	NZ=1
C  =1 TO DRAG ALONG VECTOR
	TYPE 432,KT
	ACCEPT 40,AB
	IF(AB.EQ.'B')GO TO 509
	IF(AB.EQ.'R')GO TO 434
	MX=NX
	MY=NY
	CALL RDCUR(NX,NY)
CC	CALL SETCUR(NX,NY,1)
	STEP=(NX+256)/5.12
	AMP=(NY-128)/256.
	IF(KT.EQ.1)STEP=1.
	IF(STEP.LT.100)GO TO 5571
	AMP=((STEP-100)/(STEP-A(KT-1,2)))*(A(KT-1,1)-AMP)+AMP
	ICUR=0
	CALL CLRCUR
	STEP=100.
5571	TYPE 37,AMP,STEP
	GO TO 5071
611	FORMAT(' NO MORE THAN 50 SEGS'/)
610	TYPE 611
509	KT=KT-1
CC	IF(ICUR)CALL SETCUR(MX,MY,1)
5091	IF(KT.LT.1)GO TO 281
	GO TO 210
432	FORMAT(I3,') <CR>=SEG, B=BACKUP, R=RETURN  '/)
510	IF(ICUR)GO TO 433
	IF(KT.EQ.1)TYPE 48
	TYPE 26,KT
	KZ=0
	ACCEPT 40,BU
	IF(BU.EQ.'B')GO TO 509
	IF(BU.EQ.'L')GO TO 431
61	REREAD 30,AMP,STEP,H
	IF(STEP.LT.1)STEP=1
	IF(BU.EQ.'X')GO TO 161
C  TYPE 'X' FOR EXPON. FUNC. + DECAY FACTOR, +1 = NO NORM.
C  WE START WITH STEP 1 (NOT 0)
5071	IF(KT.GT.50)GO TO 610
C   TOO MANY SEGS
	IF(Z.GT.0)TYPE 371,KT,AMP,STEP
	IF(STEP.GT.100)STEP=100
	DIF=AMP-Y
	IF(STEP-X.LE.0.AND.KT.NE.1)GO TO 504
C   SO IT CAN'T BACKUP HERE
	IF(STEP.LE.1.)Y=AMP
203	YSTP=STEP
	IF(YSTP.GT.1)GO TO 1203
	YSTP=0
	X=-1
1203	JJX=X*5.120-256
	NX=YSTP*5.120-256
	NY=AMP*256.+128.
	IZ=Y*256.+128.
	CALL ALINE(JJX,IZ,NX,NY)
	CALL DPYOUT(1)
12	Y=AMP
	X=YSTP
	A(KT,1)=Y
CC	A(KT,2)=X
	A(KT,2)=STEP
7001	KT=KT+1
C   KT COUNTS SEGMENTS
	IF(STEP.LT.100)GO TO 504
	GO TO 201

7000	IF(ISMOO)GO TO 201
	IF(KT.LE.20)GO TO 7007
	TYPE 7008
	GO TO 509
7008	FORMAT(' NO MORE THAN 20 SEGS IN CURVES'/)
7007	CALL SSS(A,KT-1,FUNC)
C   DRAWS GRID 2
7009	CALL DPY(FUNC,2)
	A(KT-1,2)=520
	ISMOO=-1
C  SO YOU CAN'T COME BACK 2 TIMES
	GO TO 201
	END